
let string_of_qualifier =
  function
      AstO.Instance -> "-"
    | AstO.Static -> "+"

let string_of_var name = name
let string_of_field name = "f_" ^ name
let string_of_temp n = Printf.sprintf "_tmp_%d" n
let string_of_type typ = typ ^ "*"

let string_of_arg_decl typ name = Printf.sprintf ": (%s) %s" (string_of_type typ) (string_of_var name)

let string_of_args =
  function
      [] -> ""
    | args -> String.concat "" (List.map (fun (typ, name) -> string_of_arg_decl typ name) args)

let generate_interface ch (AstO.Class (name, base, fields, methods) as cls) =
  let emit s =
    output_string ch s;
    output_string ch "\n"
  in
    emit (Printf.sprintf "#import <%s.h>" base);
    List.iter
      (fun cls -> emit (Printf.sprintf "@class %s;" cls))
      (AstO.dependencies cls);
    emit (Printf.sprintf "\n@interface %s : %s {" name base);
    emit "@private";
    List.iter
      (fun (typ, fname) ->
	 emit (Printf.sprintf "  %s %s;" (string_of_type typ) (string_of_field fname))
      )
      fields;
    emit "}";
    emit (Printf.sprintf "  - (id) init%s%s;" name (string_of_args fields));
    List.iter
      (fun (AstO.Method (qualifier, typ, name, args, _)) ->
	 emit (Printf.sprintf "  %s (%s) %s%s;"
		 (string_of_qualifier qualifier)
		 (string_of_type typ)
		 name
		 (string_of_args args))
      )
      methods;
    emit "@end"

let compile_expr ch expr =
  let result = ref [] in
  let output s = result := s :: !result in
  let string_of_bool b = if b then "TRUE" else "FALSE" in
  let string_of_string s = Printf.sprintf "@\"%s\"" (String.escaped s) in
  let alloc typ value =
    output (Printf.sprintf "[[%s alloc] initWith%s: %s]" typ typ value)
  in
  let rec aux =
    function
	AstO.Const k -> aux_const k
      | AstO.Id "this" -> output "self"
      | AstO.Id name -> output (string_of_var name)
      | AstO.Cast (typ, e) ->
	  output (Printf.sprintf "((%s)" (string_of_type typ));
	  aux e;
	  output ")"
      | AstO.FieldAccess (AstO.Id "this", field_name) -> output (string_of_field field_name)
      | AstO.FieldAccess (e, field_name) ->
	  output "[";
	  aux e;
	  output (Printf.sprintf " %s]" (string_of_field field_name))
      | AstO.MethodCall (e, name, args) ->
	  output "[";
	  aux e;
	  output (Printf.sprintf " %s" name);
	  List.iter aux_arg args;
	  output "]"
      | AstO.StaticCall (cls, name, args) ->
	  output (Printf.sprintf "[%s %s" cls name);
	  List.iter aux_arg args;
	  output "]"
      | AstO.Let (vars, e) -> aux_let vars e
      | AstO.New (objs, e) -> aux_new objs e
      | AstO.If (e1, e2, e3) ->
	  output "(";
	  aux e1;
	  output " ? ";
	  aux e2;
	  output " : ";
	  aux e3;
	  output ")"
  and aux_const =
    function
	Const.Int n -> alloc "Int" (string_of_int n)
      | Const.Float f -> alloc "Float" (string_of_float f)
      | Const.Bool b -> alloc "Bool" (string_of_bool b)
      | Const.String s -> alloc "String" (string_of_string s)
  and aux_arg expr =
    output ": ";
    aux expr
  and aux_let vars e =
    let indexed_objs = List.combine (ListAux.make_range 1 (List.length vars)) vars in
      output "({";
      List.iter
	(fun (index, (_, e)) ->
	   output (Printf.sprintf "const id %s = " (string_of_temp index));
	   aux e;
	   output ";"
	)
	indexed_objs;
      List.iter
	(fun (index, (name, _)) ->
	   output (Printf.sprintf "const id %s = %s;" (string_of_var name) (string_of_temp index))
	)
	indexed_objs;
      List.iter
	(fun (_, (name, _)) ->
	   output (Printf.sprintf "[%s autorelease];" (string_of_var name))
	)
	indexed_objs;
      aux e;
      output ";})"
  and aux_new objs e =
    let indexed_objs = List.combine (ListAux.make_range 1 (List.length objs)) objs in
      output "({";
      List.iter
	(fun (index, (_, cls, _)) ->
	   output (Printf.sprintf "const %s* %s = [%s alloc];" cls (string_of_temp index) cls)
	)
	indexed_objs;
      List.iter
	(fun (index, (name, cls, args)) ->
	   output (Printf.sprintf "const %s %s = [%s init%s" (string_of_type cls) (string_of_var name) (string_of_temp index) cls);
	   List.iter aux_arg args;
	   output "];"
	)
	indexed_objs;
      List.iter
	(fun (_, (name, _, _)) ->
	   output (Printf.sprintf "[%s autorelease];" (string_of_var name))
	)
	indexed_objs;
      aux e;
      output ";})"
  in
    aux expr;
    List.iter (output_string ch) (List.rev !result)

let compile_method ch =
  function
      None -> output_string ch "  return nil; /* THIS IS A PURE VIRTUAL METHOD */\n"
    | Some expr ->
	output_string ch "  return ";
	compile_expr ch expr;
	output_string ch ";\n"

let generate_implementation ch (AstO.Class (name, base, fields, methods) as cls) =
  let emit s =
    output_string ch s;
    output_string ch "\n"
  in
    emit (Printf.sprintf "#import <%s.h>" name);
    List.iter
      (fun cls -> emit (Printf.sprintf "#import <%s.h>" cls))
      (AstO.dependencies cls);
    emit (Printf.sprintf "\n@implementation %s" name);
    emit (Printf.sprintf "- (id) init%s%s" name (string_of_args fields));
    emit "{";
    emit "  if ((self = [super init])) {";
    List.iter
      (fun (_, field_name) ->
	 emit (Printf.sprintf "    [%s retain];" (string_of_var field_name));
	 emit (Printf.sprintf "    %s = %s;" (string_of_field field_name) (string_of_var field_name)))
      fields;
    emit "  }";
    emit "  return self;";
    emit "}";
    List.iter
      (fun (AstO.Method (qualifier, typ, name, args, body)) ->
	 emit (Printf.sprintf "\n%s (%s) %s%s"
		 (string_of_qualifier qualifier)
		 (string_of_type typ)
		 name
		 (string_of_args args));
	 emit "{";
	 compile_method ch body;
	 emit "}";
      )
      methods;
    emit "@end"

let generate_class (AstO.Class (name, _, _, _) as cls) =
  let ch_interface = open_out (name ^ ".h") in
  let ch_implementation = open_out (name ^ ".m") in
    prerr_endline (Printf.sprintf "Generating class %s..." name);
    generate_interface ch_interface cls;
    generate_implementation ch_implementation cls;
    close_out ch_interface;
    close_out ch_implementation

      
